home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0493 / TAGLINES.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-22  |  6KB  |  197 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 415 of 535
  3. From : Bob Swart                           2:281/256.12         18 Apr 93  16:14
  4. To   : Travis Griggs                       1:3807/8.0
  5. Subj : Find Dupes
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hi Travis!
  8.  
  9.  > Here's the code.  Don't worry about the structure of it.  I know it is
  10.  > bad but this was a quick and dirty little util I wrote up that I needed.
  11.  > Have fun with it and try to speed it up.
  12. Here it is, all new and much faster. I used an internal binary tree to manage
  13. the taglines. You can store up to the available RAM in taglines:}
  14.  
  15.  
  16. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}
  17. {$M 16384,0,655360}
  18. uses Crt;
  19. Type TBuffer  = Array[0..$4000] of Char;
  20.  
  21. Const
  22.   Title = 'TagLines 0.2 by Bob Swart for Travis Griggs'#13#10;
  23.   Usage = 'Usage: TagLines infile outfile'#13#10#13#10+
  24.           '       Taglines will remove dupicate lines from infile.'#13#10+
  25.           '       Resulting text is placed in outfile.'#13#10;
  26.  
  27.   NumLines: LongInt = 0; { total number of lines in InFile }
  28.   NmLdiv80: LongInt = 0; { NumLines div 80, for 'progress' }
  29.   CurrentL: LongInt = 0; { current lineno read from InFile }
  30.  
  31. Type
  32.   String80 = String[80];
  33.  
  34.   PBinTree = ^TBinTree;
  35.   TBinTree = record
  36.                Info: String80;
  37.                left,right: PBinTree
  38.              end;
  39.  
  40. var InBuf,OutBuf: TBuffer;
  41.     InFile, OutFile: Text;
  42.     TagLine: String80;
  43.     Root,Current,Prev: PBinTree;
  44.     i: Integer;
  45.     SaveExit: pointer;
  46.  
  47.  
  48.     function CompStr(var Name1,Name2: String): Integer; Assembler;
  49.     { Author: drs. Robert E. Swart
  50.     }
  51.     ASM
  52.           push  DS
  53.           lds   SI,Name1               { ds:si pts to Name1       }
  54.           les   DI,Name2               { es:di pts to Name2       }
  55.           cld
  56.           lodsb                        { get String1 length in AL }
  57.           mov   AH,ES:[DI]             { get String2 length in AH }
  58.           inc   DI
  59.           mov   BX,AX                  { save both lengths in BX  }
  60.           xor   CX,CX                  { clear cx                 }
  61.           mov   CL,AL                  { get String1 length in CX }
  62.           cmp   CL,AH                  { equal to String2 length? }
  63.           jb    @Len                   { CX stores minimum length }
  64.           mov   CL,AH                  { of string1 and string2   }
  65.     @Len: jcxz  @Exit                  { quit if null             }
  66.  
  67.    @Loop: lodsb                        { String1[i] in AL         }
  68.           mov   AH,ES:[DI]             { String2[i] in AH         }
  69.           cmp   AL,AH                  { compare Str1 to Str2     }
  70.           jne   @Not                   { loop if equal            }
  71.           inc   DI
  72.           loop  @Loop                  { go do next char          }
  73.           jmp   @Exit                  { Strings OK, Length also? }
  74.  
  75.     @Not: mov   BX,AX                  { BL = AL = String1[i],
  76.                                          BH = AH = String2[i]     }
  77.    @Exit: xor   AX,AX
  78.           cmp   BL,BH                  { length or contents comp  }
  79.           je    @Equal                 { 1 = 2: return  0         }
  80.           jb    @Lower                 { 1 < 2: return -1         }
  81.           inc   AX                     { 1 > 2: return  1         }
  82.           inc   AX
  83.   @Lower: dec   AX
  84.   @Equal: pop   DS
  85.     end {CompStr};
  86.  
  87.  
  88.     procedure Stop; far;
  89.     begin
  90.       ExitProc := SaveExit;
  91.       Close(InFile);
  92.       Close(OutFile);
  93.     end {Stop};
  94.  
  95. begin
  96.   writeln(Title);
  97.   if Paramcount <> 2 then
  98.   begin
  99.     writeln(Usage);
  100.     Halt
  101.   end;
  102.  
  103.   Assign(InFile,ParamStr(1));
  104.   SetTextBuf(InFile,InBuf);
  105.   Reset(InFile);
  106.   if IOResult <> 0 then
  107.   begin
  108.     writeLn('Error: could not open ', ParamStr(1));
  109.     Halt(1)
  110.   end;
  111.  
  112.   Assign(OutFile,ParamStr(2));
  113.   SetTextBuf(OutFile,OutBuf);
  114.   Reset(OutFile);
  115.   if IOResult = 0 then
  116.   begin
  117.     writeLn('Error: file ', ParamStr(2),' already exists');
  118.     Halt(2)
  119.   end;
  120.  
  121.   Rewrite(OutFile);
  122.   if IOResult <> 0 then
  123.   begin
  124.     writeLn('Error: could not create ', ParamStr(2));
  125.     Halt(3)
  126.   end;
  127.  
  128.   SaveExit := ExitProc;
  129.   ExitProc := @Stop;
  130.  
  131.   while not eof(InFile) do
  132.   begin
  133.     readln(InFile);
  134.     Inc(NumLines);
  135.   end;
  136.   writeln('There are ',NumLines,' lines in this file.'#13#10);
  137.   writeln('Press any key to stop the search for duplicate lines');
  138.   NmLdiv80 := NumLines div 80;
  139.  
  140.   Root := nil;
  141.   reset(InFile);
  142.   while CurrentL <> NumLines do
  143.   begin
  144.     if KeyPressed then Halt { calls Stop };
  145.     Inc(CurrentL);
  146.     if (CurrentL AND NmLdiv80) = 0 then write('#');
  147.     readln(InFile,TagLine);
  148.  
  149.     if root = nil then { first TagLine }
  150.     begin
  151.       New(Root);
  152.       Root^.left := nil;
  153.       Root^.right := nil;
  154.       Root^.Info := TagLine;
  155.       writeln(OutFile,tagLine)
  156.     end
  157.     else { binary search for TagLine }
  158.     begin
  159.       Current := Root;
  160.       repeat
  161.         Prev := Current;
  162.         i := CompStr(Current^.Info,TagLine);
  163.         if i > 0 then Current := Current^.left
  164.         else
  165.           if i < 0 then Current := Current^.right
  166.       until (i = 0) or (Current = nil);
  167.  
  168.       if i <> 0 then { TagLine not found }
  169.       begin
  170.         New(Current);
  171.         Current^.left := nil;
  172.         Current^.right := nil;
  173.         Current^.Info := TagLine;
  174.  
  175.         if i > 0 then Prev^.left := Current { Current before Prev }
  176.                  else Prev^.right := Current { Current after Prev };
  177.         writeln(OutFile,TagLine)
  178.       end
  179.     end
  180.   end;
  181.   writeln(#13#10'100% Completed, result is in file ',ParamStr(2))
  182.   { close is done by Stop }
  183. end.
  184.  
  185.  > I hope this compiles I took out some stuff that would display a little
  186.  > picture of a sword and show the version and product name.
  187. I put something like thta just in, again.
  188.  
  189.  > I also tried DJ's idea of the buffer of 65535 but it said the structure
  190.  > was too large. So I used 64512.
  191. Always try to use a multiple of 4K, because the hard disk 'eats' space in these
  192. chunks. Reading/Writing in these chunks goes a lot faster that way.
  193.  
  194. Let me know if it isn't fast enough, or you want some more or something else.
  195.  
  196. Groetjes,
  197.           Bob